home *** CD-ROM | disk | FTP | other *** search
- Program _3D_Filled_Vectorgraphics_Demo;
- {
- ┌────────────────────────────────────────────────────────────────────────┐
- │ G∙A∙M∙E - Gaming Applications Made Easy v1.0ß (C)1993/94 L.Bakker │
- │ │
- │ A simple program to demonstrate G∙A∙M∙E's abilities to do 3D-filled │
- │ vector graphics. Have fun! │
- └────────────────────────────────────────────────────────────────────────┘
- }
-
-
- {$IfDef Ver70}
- {$R-,S-,B-,Q-,F-,E-,N-,A+,X+}
- {$Else} {$IfDef Ver60}
- {$R-,S-,B-,F-,E-,N-,A+,X+}
- {$Endif} {$EndIf}
-
-
- Uses TGK_MAIN,TGK_TEXT,TGK_GP,TGK_3D,TGK_IO,TGK_SND;
-
- Const X1 : Integer = 3; { Increments for moving objects: }
- Y1 : Integer = 3;
- X2 : Integer = -3;
- Y2 : Integer = 6;
-
- Procedure MakeChecker(Nr:Word);
- Var X,Y:Byte;
- Begin
- InitObject(Nr);
- For X:=1 to 10 do
- For Y:=1 to 10 do
- AddPoint(Nr,X*20,Y*20,0);
- For X:=1 to 9 do
- For Y:=1 to 9 do
- AddSurface4(Nr,(10*(X-1))+Y+1,(10*X)+Y+1,(10*X)+Y,(10*(X-1))+Y,X+Y*2+192,0);
- End;
-
- Procedure MakeCube(Nr:Word);
- Begin
- InitObject(Nr);
- AddPoint(Nr, 50,-50,-50);
- AddPoint(Nr, 50, 50,-50);
- AddPoint(Nr, 50, 50, 50);
- AddPoint(Nr, 50,-50, 50);
-
- AddPoint(Nr,-50,-50,-50);
- AddPoint(Nr,-50, 50,-50);
- AddPoint(Nr,-50, 50, 50);
- AddPoint(Nr,-50,-50, 50);
-
- AddSurface4(Nr,1,2,3,4,4,19);
- AddSurface4(Nr,4,3,7,8,7,40);
- AddSurface4(Nr,8,7,6,5,5,48);
- AddSurface4(Nr,5,6,2,1,9,46);
- AddSurface4(Nr,6,7,3,2,6,45);
- AddSurface4(Nr,8,5,1,4,8,47);
- End;
-
- Procedure MakePresent(Nr:Word);
- Begin
- InitObject(Nr);
-
- AddPoint(Nr,-50,-50, 50); {1} {Front - Row #1}
- AddPoint(Nr,-50,-10, 50);
- AddPoint(Nr,-50, 10, 50);
- AddPoint(Nr,-50, 50, 50); {4}
-
- AddPoint(Nr,-50,-50, 10); {5} {Front - Row #2}
- AddPoint(Nr,-50,-10, 10);
- AddPoint(Nr,-50, 10, 10);
- AddPoint(Nr,-50, 50, 10); {8}
-
- AddPoint(Nr,-50,-50,-10); {9} {Front - Row #3}
- AddPoint(Nr,-50,-10,-10);
- AddPoint(Nr,-50, 10,-10);
- AddPoint(Nr,-50, 50,-10); {12}
-
- AddPoint(Nr,-50,-50,-50); {13} {Front - Row #4}
- AddPoint(Nr,-50,-10,-50);
- AddPoint(Nr,-50, 10,-50);
- AddPoint(Nr,-50, 50,-50); {16}
-
-
- AddPoint(Nr, 50,-50, 50); {17} {Back - Row #1}
- AddPoint(Nr, 50,-10, 50);
- AddPoint(Nr, 50, 10, 50);
- AddPoint(Nr, 50, 50, 50); {20}
-
- AddPoint(Nr, 50,-50, 10); {21} {Back - Row #2}
- AddPoint(Nr, 50,-10, 10);
- AddPoint(Nr, 50, 10, 10);
- AddPoint(Nr, 50, 50, 10); {24}
-
- AddPoint(Nr, 50,-50,-10); {25} {Back - Row #3}
- AddPoint(Nr, 50,-10,-10);
- AddPoint(Nr, 50, 10,-10);
- AddPoint(Nr, 50, 50,-10); {28}
-
- AddPoint(Nr, 50,-50,-50); {29} {Back - Row #4}
- AddPoint(Nr, 50,-10,-50);
- AddPoint(Nr, 50, 10,-50);
- AddPoint(Nr, 50, 50,-50); {32}
-
-
- AddPoint(Nr,-10,-50, 50); {33} {FM - Row #1}
- AddPoint(Nr,-10,-10, 50);
- AddPoint(Nr,-10, 10, 50);
- AddPoint(Nr,-10, 50, 50); {36}
-
- AddPoint(Nr,-10, 50, 10); {37} {FM Right}
- AddPoint(Nr,-10, 50,-10); {38}
-
- AddPoint(Nr,-10,-50,-50); {39} {FM - Row #4}
- AddPoint(Nr,-10,-10,-50);
- AddPoint(Nr,-10, 10,-50);
- AddPoint(Nr,-10, 50,-50); {42}
-
- AddPoint(Nr,-10,-50, 10); {43} {FM Left}
- AddPoint(Nr,-10,-50,-10); {44}
-
-
- AddPoint(Nr, 10,-50, 50); {45} {BM - Row #1}
- AddPoint(Nr, 10,-10, 50);
- AddPoint(Nr, 10, 10, 50);
- AddPoint(Nr, 10, 50, 50); {48}
-
- AddPoint(Nr, 10, 50, 10); {49} {FM Right}
- AddPoint(Nr, 10, 50,-10); {50}
-
- AddPoint(Nr, 10,-50,-50); {51} {FM - Row #4}
- AddPoint(Nr, 10,-10,-50);
- AddPoint(Nr, 10, 10,-50);
- AddPoint(Nr, 10, 50,-50); {54}
-
- AddPoint(Nr, 10,-50, 10); {55} {FM Left}
- AddPoint(Nr, 10,-50,-10); {56}
-
- AddSurface4(Nr,17,18,22,21,105,0); {Achtervlak}
- AddSurface4(Nr,19,20,24,23,105,0);
- AddSurface4(Nr,25,26,30,29,105,0);
- AddSurface4(Nr,27,28,32,31,105,0);
-
- AddSurface4(Nr,18,19,23,22,4,2);
- AddSurface4(Nr,21,22,26,25,4,2);
- AddSurface4(Nr,22,23,27,26,4,2);
- AddSurface4(Nr,23,24,28,27,4,2);
- AddSurface4(Nr,26,27,31,30,4,2);
-
- AddSurface4(Nr,17,45,46,18,106, 0); {Achter-Midden}
- AddSurface4(Nr,19,47,48,20,106, 0);
- AddSurface4(Nr,18,46,47,19,4, 2);
-
- AddSurface4(Nr,20,48,49,24,108, 0);
- AddSurface4(Nr,28,50,54,32,108, 0);
- AddSurface4(Nr,24,49,50,28,4, 2);
-
- AddSurface4(Nr,32,54,53,31,107,0);
- AddSurface4(Nr,30,52,51,29,107,0);
- AddSurface4(Nr,31,53,52,30,4, 2);
-
- AddSurface4(Nr,56,25,29,51,109,0);
- AddSurface4(Nr,45,17,21,55,109,0);
- AddSurface4(Nr,55,21,25,56,4, 2);
-
- AddSurface4(Nr,45,33,34,46,4, 2); {Midden Midden}
- AddSurface4(Nr,46,34,35,47,4, 2);
- AddSurface4(Nr,47,35,36,48,4, 2);
-
- AddSurface4(Nr,48,36,37,49,4, 2);
- AddSurface4(Nr,49,37,38,50,4, 2);
- AddSurface4(Nr,50,38,42,54,4, 2);
-
- AddSurface4(Nr,54,42,41,53,4, 2);
- AddSurface4(Nr,53,41,40,52,4, 2);
- AddSurface4(Nr,52,40,39,51,4, 2);
-
- AddSurface4(Nr,44,56,51,39,4, 2);
- AddSurface4(Nr,43,55,56,44,4, 2);
- AddSurface4(Nr,33,45,55,43,4, 2);
-
-
- AddSurface4(Nr,33, 1, 2,34,106, 0); {Voor-Midden}
- AddSurface4(Nr,35, 3, 4,36,106, 0);
- AddSurface4(Nr,34, 2, 3,35,4, 2);
-
- AddSurface4(Nr,36, 4, 8,37,108, 0);
- AddSurface4(Nr,38,12,16,42,108, 0);
- AddSurface4(Nr,37, 8,12,38,4, 2);
-
- AddSurface4(Nr,42,16,15,41,107,0);
- AddSurface4(Nr,40,14,13,39,107,0);
- AddSurface4(Nr,41,15,14,40,4, 2);
-
- AddSurface4(Nr, 9,44,39,13,109, 0);
- AddSurface4(Nr, 1,33,43, 5,109, 0);
- AddSurface4(Nr, 5,43,44, 9,4, 2);
-
-
- AddSurface4(Nr, 1, 5, 6, 2,110,0); {VoorVlak}
- AddSurface4(Nr, 3, 7, 8, 4,110,0);
- AddSurface4(Nr, 9,13,14,10,110,0);
- AddSurface4(Nr,11,15,16,12,110,0);
-
- AddSurface4(Nr, 2, 6, 7, 3,4,2);
- AddSurface4(Nr, 5, 9,10, 6,4,2);
- AddSurface4(Nr, 6,10,11, 7,4,2);
- AddSurface4(Nr, 7,11,12, 8,4,2);
- AddSurface4(Nr,10,14,15,11,4,2);
- End;
-
- Procedure MakeMTV(Nr:Word);
- Begin
- InitObject(Nr);
-
- AddPoint(Nr, 25,-50,-50);
- AddPoint(Nr, 25,-20,-50);
- AddPoint(Nr, 25,-20, 50);
- AddPoint(Nr, 25,-50, 50);
-
- AddPoint(Nr, 25, 0,-20);
- AddPoint(Nr, 25, 0, 20);
-
- AddPoint(Nr, 25,-20, 0);
- AddPoint(Nr, 25, 20, 0);
-
- AddPoint(Nr, 25, 20,-50);
- AddPoint(Nr, 25, 50,-50);
- AddPoint(Nr, 25, 50, 50);
- AddPoint(Nr, 25, 20, 50);
-
- AddPoint(Nr,-25,-50,-50);
- AddPoint(Nr,-25,-20,-50);
- AddPoint(Nr,-25,-20, 50);
- AddPoint(Nr,-25,-50, 50);
-
- AddPoint(Nr,-25, 0,-20);
- AddPoint(Nr,-25, 0, 20);
-
- AddPoint(Nr,-25,-20, 0); {19}
- AddPoint(Nr,-25, 20, 0); {20}
-
- AddPoint(Nr,-25, 20,-50); {21}
- AddPoint(Nr,-25, 50,-50); {22}
- AddPoint(Nr,-25, 50, 50); {23}
- AddPoint(Nr,-25, 20, 50); {24}
-
- AddPoint(Nr,-35, 20,-30); {25} {T van TV - Vertical part}
- AddPoint(Nr,-35, 30,-30); {26}
- AddPoint(Nr,-35, 25,-55); {27}
-
-
- AddPoint(Nr,-35, 10,-30); {28} {T van TV - Horizontal part}
- AddPoint(Nr,-35, 40,-25); {29}
- AddPoint(Nr,-35, 40,-35); {30}
-
- AddPoint(Nr,-35, 35,-30); {31} {V van TV}
- AddPoint(Nr,-35, 45,-55); {32}
- AddPoint(Nr,-35, 50,-45); {33}
-
- AddPoint(Nr,-35, 45,-55); {34}
- AddPoint(Nr,-35, 55,-30); {35}
- AddPoint(Nr,-35, 65,-30); {36}
-
- AddPoint(Nr, 25,-25, 0); {37}
- AddPoint(Nr, 25, 25, 0);
- AddPoint(Nr,-25,-25, 0); {39}
- AddPoint(Nr,-25, 25, 0);
-
-
- AddSurface3(Nr,25,26,27,1,0); {Voorkant TV-Tekens}
- AddSurface3(Nr,28,29,30,1,0);
- AddSurface3(Nr,31,33,32,9,0);
- AddSurface3(Nr,35,36,34,9,0);
-
- { From Left&Right: (Links->Rechts, Onder->Boven, Achter->Voren) }
- AddSurface4(Nr,16, 4, 1,13, 44,0);
- AddSurface4(Nr, 7,19,14, 2, 46,0);
- AddSurface4(Nr, 3,15,18, 6, 46,0);
- AddSurface4(Nr,19, 7, 5,17, 44,0);
- AddSurface4(Nr, 8,20,17, 5, 46,0);
- AddSurface4(Nr,24,12, 6,18, 44,0);
- AddSurface4(Nr,20, 8, 9,21, 44,0);
- AddSurface4(Nr,11,23,22,10, 46,0);
-
-
-
- {From Below: (Van Onder->Boven)}
- AddSurface4(Nr, 1, 2,14,13, 42,0);
- AddSurface4(Nr, 9,10,22,21, 42,0);
-
- {From Above: (Van Onder->Boven)}
- AddSurface4(Nr,16,15, 3, 4, 42,0);
- AddSurface4(Nr,24,23,11,12, 42,0);
-
- {From Rear: (Van achter->Voren)}
-
- AddSurface4(Nr,15,16,13,14, 38,0);
- AddSurface4(Nr,18,15,39,17, 38,0);
- AddSurface4(Nr,24,18,17,40, 38,0);
- AddSurface4(Nr,23,24,21,22, 38,0);
-
- {From Front: (Van achter->Voren)}
-
- AddSurface4(Nr,4,3,2,1,38,0);
- AddSurface4(Nr,3,6,5,37,38,0);
- AddSurface4(Nr,6,12,38,5,38,0);
- AddSurface4(Nr,12,11,10,9,38,0);
-
- AddSurface3(Nr,26,25,27,1,0); {Achterkant TV-Tekens}
- AddSurface3(Nr,29,28,30,1,0);
- AddSurface3(Nr,31,32,33,9,0);
- AddSurface3(Nr,35,34,36,9,0);
- End;
-
- Procedure MakeDiamond(Nr:Word);
- Begin
- InitObject(Nr);
- AddPoint(Nr, 20, 10,-20);
- AddPoint(Nr, 10, 20,-20);
- AddPoint(Nr,-10, 20,-20);
- AddPoint(Nr,-20, 10,-20);
- AddPoint(Nr,-20,-10,-20);
- AddPoint(Nr,-10,-20,-20);
- AddPoint(Nr, 10,-20,-20);
- AddPoint(Nr, 20,-10,-20);
- AddSurface4(Nr,1,2,3,4,127,4);
- AddSurface4(Nr,1,4,5,8,127,4);
- AddSurface4(Nr,8,5,6,7,127,4);
-
- AddPoint(Nr, 60, 30,25); {9}
- AddPoint(Nr, 30, 60,25);
- AddPoint(Nr,-30, 60,25);
- AddPoint(Nr,-60, 30,25);
- AddPoint(Nr,-60,-30,25);
- AddPoint(Nr,-30,-60,25);
- AddPoint(Nr, 30,-60,25);
- AddPoint(Nr, 60,-30,25);
- AddSurface4(Nr,9,10, 2,1,47,61);
- AddSurface4(Nr,10,11,3,2,46,61);
- AddSurface4(Nr,11,12,4,3,47,61);
- AddSurface4(Nr,12,13,5,4,46,61);
- AddSurface4(Nr,13,14,6,5,47,61);
- AddSurface4(Nr,14,15,7,6,46,61);
- AddSurface4(Nr,15,16,8,7,47,61);
- AddSurface4(Nr,16, 9,1,8,46,61);
-
- AddPoint(Nr,0,0,100);
-
- { AddSurface3(Nr,17,10, 9,126,61);
- AddSurface3(Nr,17,11,10,125,1);
- AddSurface3(Nr,17,12,11,126,61);
- AddSurface3(Nr,17,13,12,125,1);
- AddSurface3(Nr,17,14,13,126,61);
- AddSurface3(Nr,17,15,14,125,1);
- AddSurface3(Nr,17,16,15,126,61);
- AddSurface3(Nr,17, 9,16,125,1);}
-
- AddSurface3(Nr,17,10, 9,46,61);
- AddSurface3(Nr,17,11,10,47,61);
- AddSurface3(Nr,17,12,11,46,61);
- AddSurface3(Nr,17,13,12,47,61);
- AddSurface3(Nr,17,14,13,46,61);
- AddSurface3(Nr,17,15,14,47,61);
- AddSurface3(Nr,17,16,15,46,61);
- AddSurface3(Nr,17, 9,16,47,61);
-
- End;
-
- Procedure MakePyramid(Nr:Word);
- Begin
- InitObject(Nr);
- AddPoint(Nr, 50,-50,-10);
- AddPoint(Nr, 50, 50,-10);
- AddPoint(Nr,-50, 50,-10);
- AddPoint(Nr,-50,-50,-10);
- AddPoint(Nr, 0, 0, 80);
-
- AddPoint(Nr, 35,-35,-25); {6}
- AddPoint(Nr, 35, 35,-25);
- AddPoint(Nr,-35, 35,-25);
- AddPoint(Nr,-35,-35,-25); {9}
- AddPoint(Nr, 0, 0, 60);
-
- AddSurface3(Nr,7,10,6,6, 1);
- AddSurface3(Nr,8,10,7,6, 2);
- AddSurface3(Nr,9,10,8,6,14);
- AddSurface3(Nr,6,10,9,6, 9);
- AddSurface4(Nr,6,7,8,9,8,42);
-
- AddSurface3(Nr,4,3,5,25,0);
- AddSurface3(Nr,1,4,5,26,0);
- AddSurface3(Nr,2,1,5,25,0);
- AddSurface3(Nr,3,2,5,26,0);
-
- AddSurface4(Nr,1,2,7,6,26,0);
- AddSurface4(Nr,2,3,8,7,27,0);
- AddSurface4(Nr,3,4,9,8,26,0);
- AddSurface4(Nr,4,1,6,9,27,0);
- End;
-
- Procedure FuzzyTab; Assembler;
- Asm
- Db 0,1,2,4,4,2,1,0 { 8 values - Simple Sine-Wave }
- Db 0 { FuzzyVal }
- End;
-
- Procedure Water(Pa:Word; Fuzzy:Boolean); Assembler;
- Asm
- Mov IsBusy,True
- Mov Bx,Pa
- Shl Bx,1
- Add Bx,Offset PageSegment
- Mov Es,[Bx]
-
- Mov Dx,3C4h { Select all 4 planes for VidMem->VidMem Copy }
- Mov Ax,0F02h
- Out Dx,Ax
- Mov Dx,3CEh { Set VGA to Write Mode 1 }
- Mov Al,5
- Out Dx,Al
- Mov Dx,3CFh
- In Al,Dx
- Or Al,1h
- Mov Al,$41
- Out Dx,Al
-
- Mov Dl,Cs:[Offset FuzzyTab+8]
- Xor Dh,Dh
-
- Push Ds
- Mov Ds,[Bx]
- Mov Si,151*80 { Starting Y Row For Water Get }
- Mov Di,150*80 { Starting Y Row For Water Put }
- Mov Al,50 { Size of "Water Field"... }
- @NextLine:
- Mov Bx,0
- Cmp Fuzzy,True
- Jne @NextFuz
- Mov Bx,Dx
- Mov Bl,Cs:[Offset FuzzyTab+Bx]
- Xor Bh,Bh
- Inc Dx
- Cmp Dx,8
- Jl @NextFuz
- Xor Dx,Dx
- @NextFuz:
- Add Di,Bx
- Mov Cx,80
- Sub Cx,Bx
- Rep MovsB
- Add Si,Bx
- Sub Si,320
- Dec Al
- Jnz @NextLine
- Pop Ds
-
- Mov Cs:[Offset FuzzyTab+8],Dl
-
- Mov Dx,3CFh { Set VGA to Write Mode 0 }
- In Al,Dx
- And Al,0FCh
- Out Dx,Al
- Mov IsBusy,False
- End;
-
- Var Count : Word;
- SCount : Byte;
- Ch : Char;
- VectorMusic : MusicType;
-
- Const Fuzzy : Boolean = False;
-
- Begin {Main}
- OpenGraphics;
- If AdlibInstalled then { Do you have one of these? }
- Begin { If not, It's not that you }
- LoadMusic(VectorMusic,'VECTDEMO.GMF'); { can't hear the music... }
- StartMusic(VectorMusic,0); { You just don't want to ;-) }
- End;
- LoadFont('VECTDEMO.GFF',1); { Set the font... }
- SetFont(1);
- SetSpacing(1);
-
- SetTextJustify(CenterText,TopText);
- OutText(160,10,22,2,'TGK Vector Demonstration');
- OutText(160,30,22,2,'(C)1993 Lennert Bakker');
- OutText(160,80,1,2,'<SPACE> to switch Fuzzy-Mode');
-
- WireColor(47);
- LineClipping:=True;
-
- MakeDiamond(2);
- SetOrigin(2,160,115);
- SizeObject(2,0.4);
-
- MakePresent(4);
- SetOrigin(4,60,50);
- SizeObject(4,0.3);
-
- MakeMTV(3);
- SetOrigin(3,260,110);
- SizeObject(3,0.5);
-
- MakePyramid(1);
- SetOrigin(1,160,100);
- SizeObject(1,0.05);
-
- Repeat
- MoveOrigin(1,X1,Y1);
- MoveOrigin(2,X2,Y2);
-
- RotateObject(1, 10, 8, 9);
- RotateObject(2,-14, 14, -8);
- RotateObject(3, 15, 10, -8);
- RotateObject(4, 10,-15, 15);
-
- Case ClipObject(1,25,MaxX-25,25,MaxY-25) of
- ClipLeft : X1:=Abs(X1);
- ClipRight : X1:=-Abs(X1);
- ClipTop : Y1:=Abs(Y1);
- ClipBottom : Y1:=-Abs(Y1);
- End;
-
- Case ClipObject(2,25,MaxX-25,25,MaxY-25) of
- ClipLeft : X2:=Abs(X2);
- ClipRight : X2:=-Abs(X2);
- ClipTop : Y2:=Abs(Y2);
- ClipBottom : Y2:=-Abs(Y2);
- End;
-
- CurPage:=1-CurPage;
- CopyPage(2,CurPage);
-
- HideObject(1);
- HideObject(2);
- HideObject(3);
- HideObject(4);
-
- DrawObjectFilled(4,CurPage);
- DrawObjectFilled(2,CurPage);
- DrawObjectFilled(3,CurPage);
- DrawObjectFilled(1,CurPage);
-
- If SCount<18 then
- Begin
- Inc(SCount);
- SizeObject(1,1.12);
- End;
-
- Water(CurPage,Fuzzy);
- ZeroLine(0,134,319,134,1,CurPage); { This is sneaky - Find out! }
- ZeroLine(0,135,319,135,1,CurPage);
-
- Sync;
- SetPage(CurPage);
-
- If Keypressed then
- Begin
- Ch:=Readkey;
- If Ch=#32 then Fuzzy:=Not Fuzzy;
- End;
-
- Until Ch=#27;
- DisposeAllObjects;
- CloseGraphics;
- Writeln('Goodbye from Vector Demonstration');
- Writeln;
- Writeln('Huh, this demo needs like car accidents and screaming tires.');
- Writeln('Yeah, right!');
- Writeln;
- Writeln('Aaaargh, DOS again!');
- Writeln;
- End.